#!/usr/bin/perl
# List referers to my Web pages as a Web page
$self = "counter.li.org";
$areaname = "the Linux Counter";
$area = "";
$areahost = "counter.li.org";
$minlist = 10;

%searchmachines = (
"www.webcrawler.com", "none",
"webcrawler.com",     "none",
"guide-p.infoseek.com", "qt=",
"www.altavista.digital.com", "q=",
"altavista.digital.com", "q=",
"av.yahoo.com", "p=",
"searcher.mckinley.com", "query=",
"www.lycos.com", "query=",
"kvasir.oslonett.no","text=",
"a2z.lycos.com","query=",
"www.hotbot.com", "MT=",
"www.excite.com", "q=",
		   );

while ($ARGV[0] =~ /^-/) {
    $opt = shift(@ARGV);
    if ($opt eq "-self") {
	$self = shift(@ARGV);
    } elsif ($opt eq "-areaname") {
	$areaname = shift(@ARGV);
    } elsif ($opt eq "-area") {
	$area = shift(@ARGV);
    } elsif ($opt eq "-bypage") {
	$bypage = 1;
    } elsif ($opt eq "-mergesearch") {
	$mergesearch = 1;
    } elsif ($opt eq "-minlist") {
	$minlist = shift;
    }
}
print STDERR "Area $area, areaname $areaname, self $self\n";
while (<>) {
    
    if (!$firstdate) {
	if (/\[([^]]+)\]/) {
	    $firstdate = $1;
        }
    }

#    if (m!([a-zA-Z0-9]+://([^/]+)/?\S*) -> (\S+)!) {
#	$url = $1;
#	$host = $2;
#	$target = $3;
#	$host =~ s/:80$//;
    chop;
    if (m!(\S+) "\S+ (\S+) +\S+" Referer:!) {
        $target = $2;
        $targethost = $1;
        $url = $';
	if ($url =~ /^http:\/\/([a-zA-Z0-9\.-]+)/i) {
	    $host = $1;
	} elsif ($url =~ m!^news:!) {
	    $host = "News article";
	} else {
	    $host = "strange URL";
	}
    } elsif (m!\S+ "-"!) {
	# weird lines
	++ $skipcount;
    } elsif (/Referer:-$/) {
	# proto errors and the like. No info, anyway
	++ $skipcount
    } else {
	print STDERR "Could not parse $_\n";
	++ $skipcount;
	next;
    }
    next if $target =~ /.gif$/; # ignore all GIFs
    next if $targethost ne $areahost; # virtual webserver
    next if $url eq "-"; # not given
    next if $target =~ /certificate.cgi/; # Counter special...
    ++ $refs;
    if ($host ne $self && $target =~ /^$area/) {
	$url =~ s/#[a-zA-Z0-9]+$//; # Delete fragment ID
	if ($mergesearch && $searchmachines{$host}) {
	    $url =~ s/\?.*$/-search/;
	}
	$host{$url} = $host;
	$target =~ s!/$!!; # Remove trailing slash - for merge w/nonslash
	$target =~ s!/index.html!!; # same for index files.
	$target = "/" if !$target; # but top node needs a name
	++ $refcount{$url, $target};
	++ $countedrefs;
    }
}
print STDERR "$refs references, $countedrefs counted, $skipcount skips\n";
print <<EoF;
<?php
 include "counter.php";

 pagestart();
 ?>
<html>
<?php pagehead("Pages that refer to $areaname") ?>
<BODY bgcolor="white">
<?php pagetop("Pages that refer to $areaname") ?>

These are the pages that are shown by my HTTPD logs as containing references
to $areaname.<br>
The logs date back to $firstdate.<br>
For ease of reading (and privacy), URLs with less than 3 accesses are
not shown.
<p>
EoF

if ($bypage) {
    for $pair (keys(%refcount)) {
	($url, $target) = split($;, $pair);
	$sumref{$target} += $refcount{$pair};
    }
    for $pair (keys(%refcount)) {
	($url, $target) = split($;, $pair);
	$sortkey{$pair} = sprintf("%4d %s %4d",
				  $sumref{$target}, $target, $refcount{$pair})
  	   if $refcount{$pair} >= $minlist;
    }
    for $pair (sort {$sortkey{$b} cmp $sortkey{$a}} (keys(%sortkey))) {
	($url, $target) = split($;, $pair);
	if ($target ne $prevtarget) {
	    $prevtarget = $target;
	    print "<h2>$sumref{$target} Refs to <a href=\"$target\">$target</a></h2>\n";
	}
	print "$refcount{$pair} from ";
	if ($url =~ m!http://([^/]+)!) {
	    $host = $1;
	    if ($searchmachines{$host} || $url =~ /\?/) {
		if ($url =~ /\?/) {
		    $search = $';
		    if ($searchmachines{$host} && $searchmachines{$host} ne "none") {
			if ($search =~ /(^|&)$searchmachines{$host}([^&]+)/) {
			    $term = $2;
			} else {
			    $term = "$search (strange)";
			} 
                    } else {
			$term = "$search (unknown)";
		    }
		    # Remove url-encoding
		    $term =~ tr/+/ /;
		    $term =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		    print "<a href=\"$url\">$host{$url}</a> searching for $term<br>\n";
		} else {
		    print
			"<a href=\"$url\">$host{$url}</a>, no search argument<br>\n";
		}
	    } else {
		($doc = $url) =~ s/\/$//;
		$doc =~ s/.*\//$1/;
		$doc =~ s/#.*//;
		print "<a href=\"http://$host{$url}\">$host{$url}</a> ",
              "document <a href=\"$url\">$doc</a><br>\n";
	    }
	} else {
	    print "<a href=\"$url\">$host{$url}</a><br>\n";

	}
    }
} else {
    for $pair (sort {$refcount{$b} <=> $refcount{$a}}(keys(%refcount))) {
	($url, $target) = split($;, $pair);
	last if $refcount{$pair} < $minlist;
	print "$refcount{$pair} refs from ",
	"<a href=$url>$host{$url}</a> to $target<br>\n";
    }
}

$date = `date`; chop $date;
print <<EoF;
<hr>
<?php print emailCloaking(\"webmaster\@counter.li.org\") ?>

<br>
Last regenerated: $date
</body> </html>
EoF

